00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLEF0, BDR40,BDI40, ETC.
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600		COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ2,RJJ(20) /FONT/JFONT
00700		DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(7),R(8,100)
00800		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01000		COMMON/ALF/INP(72),ML/STF/RSTFAC(-3/4),RSTJ2
01050		1/POSI/STFF(-3/4),JJ2,POS
01100		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01300		COMMON/XRN/RN(4000)/DPY/ST(4000),WDS(250),MEDIT,IGO	
01400		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01500		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01600		1,(J11,JQ(9)),(J6,JQ(4)),(R7,RJQ(5)),(R4,RJQ(2)),(IT,LY(7))
01700		1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(LX(8),IL),(I3,INP(3))
01800		1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(SET4,RN(3920)),(R,RN(3001))
01900		1 ,(TOP,ST(3999)),(BOT,ST(4000)),(R8,RJQ(6)),(RJ3,RJJ(1))
01950		1 ,(R9,RJQ(7)),(IBEAM,RN(3000))
02000		1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(R13,RJQ(11))
02100		1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02110		1,(LX(2),ICC),(LX(5),IG)
02200		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02300		1 ,LST/'NOTE','REST','CLEF','LINE','SLUR',
02400		1 'BEAM','TRILL','STAFF','MISC','NUMB','WORD','KSIG','METER'/
02500		1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
02600		1 'S','U','X'/
02700		1,LY/' ','A','B','D','E','F','T'/
02800	
02860		LCEN=0
02870		MCEN=0
02900		TOP2=-999
03050	C  IF -1, THEN TRUE OUTLINES OF FONTS ARE DISPLAYED.
03100		I1=0
03120		DIS=1.
03140		RHT=1.
03160	C  FOR 'FILLER' ON CRT.
03300	2	CALL DPYSET(1,ST,4000)
03310		CALL HYDPOG(1)
03400		CALL TYPLOC(-180,-511)
03500		CALL DPYBRT(5)
03510		JFONT=0
03600		RPOS(1,1)=0
03700		PLOTIT=0
03800		RSZ=.845
03900		TOP=-999
04000		BOT=999
04200		X22=0
04300		JCEN=0
04400		KCEN=0
04500		PLT=0
04600		PWDS(1)=1.
04700		EDX=-1
04800		SAVER=7
04900		DO 1402 K=-3,4
05000	1402	RSTFAC(K)=1.
05100		REDIT=999.
05200		M=1
05300		ITEM=0
05400		ZERO=-1
05500		WDS(1)=4
05600	C  DATA IN DPY ARRAY STARTS AT WD.4!
05700		I=1
05800	1100	SCORE=-1
07200	58	IGO=-1
07300		GO TO 5505
07400	
07600	11	CALL NOTWRT
07700	57	IF(PLT)GO TO 6120
07710		IF(M.GT.I)GO TO 571
07800		IF(IGO)CALL DPYOUT(1)
08000	571	ITEM=ITEM+1
08010		IF(ITEM.LT.250)GO TO 17
08020		TYPE 170,ITEM
08030		I=PWDS(250)
08040		ITEM=249
08050		ST2=WDS(250)
08055		CALL DPYOUT(1)
08060		GO TO 1100
08070	170	FORMAT(2(' **** TOO MANY ITEMS ',I3,'/249'/))
08100	17	IF(IGO.GT.0)GO TO 20000
08200		K=ST2
08300		IF(X22.EQ.0)GO TO 20000
08400		CALL BOX(IBOX,RBOX,STFF)
08500		ST2=K
08600	20000	WDS(ITEM+1)=ST2
08610		IF(EDX.EQ.-1)GO TO 1571
08700		IF(M.LT.I)GO TO 6120
08800	1571	IF(PLOTIT.EQ.-2)GO TO 2311
08900	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
09000		PWDS(ITEM+1)=I
09100		PLT=0
09200		IF(IGO.NE.0)GO TO 55
09300		CALL DPYOUT(1)
09310		IF(SCORE.EQ.0)GO TO 9532
09355	C  GO GET MORE FROM SCX.
09400		IGO=-1
09500	
10200	55	IF(SCORE.EQ.0)GO TO 553
10300	5505	SVST=ST2
10400	C CATCHES TYPO WITH 'C'
10500		K=ITEM+1
10600		IF(X22.EQ.0)GO TO 5503
10700		K=X22
10800		L=RN(MEDIT+1)
10900		IF(L.EQ.13)L=11
10910	CC	IF(L.EQ.10)L=9
11000	CC	IF(L.GE.16.AND.L.LE.18)L=L-5
11020		IF(L.GE.11)L=L-1
11040		IF(L.GE.15)L=L-4
11100	CC	IF(L.EQ.20)L=12
11400		TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
11500		IF(YED.LT.2)GO TO 5504
11600	C   YED IS SET AT 426
11700	5502	DO 5501 L=4,YED+2
11800	5501	TYPE 4271,L,RN(MEDIT+L)
11900		GO TO 5504
12300	
12400	5503	CALL HYDPOG(3)
12500	C  TO DELETE VERTICAL LINE (55)
12600		KED=0
12900	5504	IF(I1.EQ.IP)GO TO 2311
13000	59	TYPE 56,NAME,K,I,SVST
13100		JAB=JA
13200		SCORE=-1
13300		ACCEPT 89,INP
13400		DO 1313 LKX=1,14
13500	1313	IF(I1.EQ.LX(LKX))GO TO 2313
13600		LKX=0
13700	2313	LKX=LKX+1
13800	C  'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF; 
13900		IF(X22.NE.0)GO TO(87,884,883,883,5313,87,884,87,883,87,59,883
14000		1,15,883,883),LKX
14100		GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
14200		1,59),LKX
14300	C                  A   C   D   E   G   I  J   L   M     P   R   S U(X
14400	C  HERE A=ALTER A GROUP, DE=DELETE A GROUP
14500	C  'DP'=DISPLAY OR HIDE WHICH STAVES.  D=DOWN N
14600	14	IF(I2-IE)883,13,884
14700	13	IGO=1
14800		CALL GRED
14850		JFONT=0
14900		IF(JA.EQ.98)GO TO 5533
15000		KNT=0
15100		SCORE=0
15250		GO TO 653
15300	15	DO 3313 LKY=1,7
15400	3313	IF(I2.EQ.LY(LKY))GO TO(312,3121,3121,3121,312,115,884),LKY
15500	C                               BL  A    B     D    E   F   T
15600	C  'SF'= SAVE AND FIXUP (I HOPE THIS IS TEMPORARY)
15700	115	IF(X22.EQ.0)CALL FIXUP
15800		GO TO 5505
15900	C  RESETS FACTORS FOR SAVE AND REDISPLAY
16000	3121	IF(X22.NE.0)GO TO 5505
16100		SAVER=7
16200		CALL SAVIT
16300		GO TO 5505
16400	312	JA=55
16500		R2=RN(MEDIT+3)
16550	C  POSITION OF ITEM LOOKED AT.
16600		R3=55.
16700		GO TO 6531
16800	C  ABOVE FOR 'S'ET ALIGNMENT
16900	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
17000	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;  'P' #S = PLOT IT
17100	5313	K=-1
17200		DO 882 JA=3,10
17300	882	IF(INP(JA).NE.IBL)GO TO 884
17400		GO TO 883
17500	885	FORMAT(A2,21F)
17600	884	REREAD 885,K,R2,RJQ
17700		JA=55
17800		IF(I1.EQ.II)JA=22
17900		IF(I2.EQ.IT)JA=44
18000		IF(I2.NE.IP)GO TO 6531
18100		IF(R2.GT.5)GO TO 1886
18200	C  GO BACK AND RESET ALL
18300		K=R2
18400		JA=0
18500	C  USE '5' FOR STAFF 0.
18600	888	IF(K.EQ.5)K=0
18700		DP(K)=-DP(K)
18800		JA=JA+1
18900		K=RJQ(JA)
19050		IF(K.EQ.0)GO TO 55
19100	C  JUMP OUT IF RJQ(JA)=0 OR 99
19150		IF(K.EQ.99)GO TO 85
19175	C*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
19200		GO TO 888
19300	C  TO GET BACK ALL LINES TYPE 6+
19400	311	JA=0
19410		IGO=1
19500		ML=0
19600		IF(I2.NE.IL)GO TO 884
19700	1886	DO 2886 K=-3,4
19800	2886	DP(K)=1
19900		IF(I1.NE.IP)GO TO 8851
20000	C PL RESETS 'DP'
20100	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
20200	2311	CALL PLTCMD
20300		IF(PLOTIT.EQ.0)GO TO 3005
20400		I1=IP
20500		PLOTIT=-1
20600		GO TO 6531
20700	C  'PL' GOES TO 'PLOT COMMAND' ROUTINE
20800	
20900	881	IF(I1.GT.0)GO TO 87
21000	C   JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
21100	883	IF(I2.EQ.IS)GO TO 2
21200	C  TYPE 'RS' TO RESTART.
21210		IF(IX.NE.I)GO TO 8831
21300		IF(I1.EQ.ICC)GO TO 72
21320	8831	IF(JA.NE.16)GO TO 8832
21330		IF(X22.EQ.0)GO TO 5505
21340	C  CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
21400	8832	CALL EDIT(JJA)
21500		IF(JA.NE.99)GO TO 6531
21520		CALL DELETE
21540	C  DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
21560		GO TO 425
21600	89	FORMAT(72A1)
21700	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
21710	
21720	101	CALL SCL
21730		GO TO 5505
21740	221	JFONT=R2
21750	C JA=44 IS FOR JFONT (DISPLAY FONT OUTLINES)-WIPED OUT BY '24' ETC.
21760		GO TO 5505
21800	
21900	87	REREAD 1,JA,R2,RJQ
22000		IF(K)JA=55
22100	C   ED 47 -1 = 55 47 -1, ETC.
22200		IF(JA.EQ.101)GO TO 101
22220		IF(JA.EQ.44)GO TO 221
22300		IF(JA.GT.0)SAVER=SAVER-1
22310		IF(X22.NE.0)GO TO 8833
22400		IF(SAVER)CALL SAVIT
22500	C  SAVES EVERY 7TH TIME AROUND
22610	8833	IF(JA.EQ.14)GO TO 88
22655		IF(JA.EQ.144)GO TO 88
22700		IF(JA.NE.16)GO TO 6531
22710	C NEXT FOR ALPHA TEXT ITEMS.
22720		M=I
22730		CALL WORDS
22740		GO TO 8852
22750	
22800	188	R3=0
23000	88	SET4=R3
23100	C  SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
23110		SCORE=0
23200		IF(JA.NE.14)GO TO 889
23300	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
23400		SAVER=-1
23410		RSTF=R2
23500		DO 1889 K=1,ITEM
23600		J=PWDS(K)
23700		IF(RN(J+1).NE.8)GO TO 1889
23800		IF(RN(J+2).EQ.R2)GO TO 889
23900	1889	CONTINUE
24000	C DIDN'T FIND THIS STAFF
24100		M=2000
24120		IGO=0
24200		JA=8
24300		GO TO 6531
24320	890	JA=14
24450	889	SPD=ST2
24460		JIT=ITEM
24500		ISC=I
24510		REND=0
24700	C   RETAINS ORIGINS OF SCORE SQUENCE
24800	9532	IF(REND.EQ.2)GO TO 889
24850	C  FOR READIN CONTINUATION.
24900		M=ISC
24905	9533	IF(JA.EQ.8)GO TO 890
24910		IF(REND)GO TO 9535
24955	C  REND=0 GO,   -1=NORMAL END,  1=ABORTED
25000		CALL SCMSS(M)
25100		IF(REND.EQ.1)GO TO 9535
25110		IF(REND.NE.99)GO TO 9534
25115		I=ISC
25117		GO TO 9535
25120	9534	ITEM=JIT
25130		J=M
25140	9536	ITEM=ITEM+1
25150		PWDS(ITEM)=J
25160		J=J+RN(J)+3
25170		IF(J.LT.I)GO TO 9536
25180		IF(IBEAM)GO TO 9537
25182		R13=0
25185		R2=RSTF
25186		JA=19
25187		J3=0
25188	C ↑↑↑↑↑↑ OR J2=0 ????????
25189		CALL HOMER
25190	9537	ITEM=JIT
26012		ST2=SPD
26075		GO TO 8852
26200	9535	SCORE=-1
26220		IGO=-1
26260		JA=16
26280	C  FOR TRAP AT 'EDIT'
26290		GO TO 5505
26295	
26300	553	IF(SCORE)GO TO 6531
26600	653	KNT=KNT+1
26700	C   NUM OF ITEMS IN LIST
26800		R11=0
26900		R10=0
27000		R9=0
27100	64	JA=R(1,KNT)
27200	264	R2=R(2,KNT)
27300		IF(JA.NE.0)GO TO 550
27350	C  =0 MEANS NO MORE ITEMS.
27700		CALL DPYOUT(1)
27900		GO TO 1100
27920	
28000	5533	X22=0
28011		IGO=-1
28022		CALL DPYNEW
28033		GO TO 55
28044	
28055	590	IF(PLOTIT.EQ.-1)GO TO 121
28066		I1=0
28077		GO TO 243
28088	C  GOES TO PLOTTER
28100	550	DO 7531 K=1,6
28200	7531	RJQ(K)=R(K+2,KNT)
29500	6531	M=1
29600		EDX=-1
29700		IF(JA.EQ.222)GO TO 72
29800		IF(JA.EQ.2222)GO TO 73
29900		DO 5532 K=1,10
30000	5532	JQ(K)=RJQ(K)
30100	CC	J2=R2
31300	7542	IF(I1.EQ.IP)GO TO 590
31400	C  X22= ITEM# WHEN EDITING OR DELETING.
31500		IF(X22.NE.0)GO TO 5511
31600		IF(JA.GT.0)GO TO 155
31700		IF(R2.EQ.0)GO TO 5505
31800	C  FOR UP, DOWN, LEFT, RIGHT
31850		RJJ2=J2
31900		GO TO 6221
32000	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
32100	155	IF(JA.EQ.24)GO TO 24
32200		IF(JA.EQ.22)GO TO 42  
32300		IF(JA.EQ.44)GO TO 44
32350	C  THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
32400		IF(JA.EQ.55)GO TO 554
32500		IF(JA.EQ.333)GO TO 6333
32600	CC	IF(IABS(J2).GT.5.OR.(IABS(J4).GT.99.AND.JA.GT.4.AND.
32700	CC	1 JA.NE.9.AND.JA.NE.10))GO TO 5505
32800	C  CATCHES SOME TYPO ERRORS IN P3 AND P4.(5/74: LIMIT WAS +-99)
32900	C  AVOIDS EXIT AFTER TYPO ERROR
33000	CC	IF(JA.EQ.21.OR.JA.EQ.19)GO TO 61
33050		IF(JA.EQ.19)GO TO 61
33100		GO TO 60
     

00100	33	J2=R2
00200		TYPE 1,J2,RJJ(J2-2)
00500	C  TYPE 33,N TO SEE FULL CONTENTS OF PARAM. N.
00600		GO TO 5505
00700	
00800	24	IGO=0
00900		IF(X22.EQ.0)GO TO 23
01000		R2=RHORZ(RN(MEDIT+3))
01100		M=RN(MEDIT+2)
01200		R4=RN(MEDIT+4)*RSTFAC(M)+STFF(M)
01300		ITEM=ITEM-1
01400	C  PICKS UP POINT FROM CURSOR IN 'BOX'
01500		CALL CLRCUR
01600		X22=0
01700		GO TO 241
01800	23	IF(R2.LT.100)GO TO 2410
01900		R5=AMOD(R2,100.)
02000		R2=IFIX(R2/100.)
02100		R3=1000.*R5-500.
02200		R4=R2*50.
02300	C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE
02400	2410	IF(R2.NE.0)GO TO 241
02500		IGO=-1
02600	243	R2=1.
02700	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
02800	241	RSZ=.845*R2
02900		JCEN=R3*RSZ
03000		KCEN=R4*RSZ
06200	2312	R2=0
06300		R3=0
06400		R4=0
06700		LCEN=0
06800		MCEN=0
06900	CC	RJSZ=1.
07000	C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
07050		JFONT=0
07100	85	M=1
07200		I=PWDS(ITEM+1)
07300		ITEM=0
07400	8552	ST2=3
07500	8852	PLT=1
07600		EDX=0
07700		CALL ACCPOG(1)
07710		IF(JA.EQ.0)GO TO 6120
07800		IF(JA.NE.24)IGO=0
07900		GO TO 6120
08000	
08100	6333	CALL LISTP(LST)
08200		GO TO 5505
08300	
08400	172	CALL JUGGLE
08500		CALL CLRCUR
08600		CALL DPYNEW
08700		IF(JA.EQ.22)GO TO 424
08800	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
08900		IF(ZERO)GO TO 55
09000		X22=ZERO
09100		ZERO=-1
09200		IF(JA.EQ.55)GO TO 554
09300		IF(JA.EQ.44)GO TO 44
09400		IF(KED.NE.0)GO TO 244
09500		GO TO 425
09600	
09700	C  55,POS  -- SETS UP ALIGNMENT
09800	554	CALL BOX(-1,R2,STFF)
09900		IF(J4.EQ.0)KED=-1
10000		RITEM=R4
10100	C  FOR 'ED POS., STF., CODE#'
10200		IF(J3.GT.4)KED=-2
10300		RLINE=R2
10400		R2=R3
10500		GO TO 45
10600	
10700	C  '22,0' EDITS LAST ITEM ENTERED
10800	42	REDIT=999.0
10900		IF(R2.NE.0)GO TO 242
11000		X22=ITEM
11100		GO TO 429
11200	44	KED=1	
11300		RITEM=R3
11400	C  'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP)
11500	45	REDIT=R2
11600	C  THE STAFF #
11700		JED=1
11800	244	X=ITEM  
11900		IF(JED.GT.X)GO TO 444
12000		DO 144 K=JED,X
12100		L=PWDS(K)
12200		IF(KED.EQ.-2)GO TO 654
12300	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
12400		IF(RN(L+2).NE.REDIT)GO TO 144
12500		IF(KED)GO TO 654
12510		IF(RITEM.EQ.0)GO TO 655
12600		IF(RITEM.NE.RN(L+1))GO TO 144
12700	655	IF(JA.NE.55)GO TO 344
12800	654	IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
12900	144	CONTINUE
13000	444	REDIT=999.
13100	C  NO MORE ON LINE
13200		R2=0
13300	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
13400		GO TO 73
13500	344	JED=K+1
13600	C  FOR NEXT TIME AROUND
13700		X22=K
13800		GO TO 429
13900	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
14000	
14100	91	CALL ACCPOG(1)
14200		IF(I.EQ.IX)ITEM=ITEM-1
14300		GO TO 142
14400	242	IF(X22.GT.0)GO TO 5511
14500	142	IF(R2.NE.0)GO TO 424
14510		IF(REDIT.EQ.999)GO TO 1554
14600		IF(JA.GE.0)GO TO 244
14700	1554	X22=X22+1
14800		IF(JA)X22=X22-1+JA
14900		IF(X22.LT.1)X22=1
15000		GO TO 425
15100	427	FORMAT(1XA5/,2F4.0,F7.2,$)
15200	4271	FORMAT('+  (',I2,')',F7.2,$)
15300	
15400	C  FOR EDITING
15500	5511	IF(JA.EQ.55)GO TO 420
15600	220	IF(JA.NE.22)GO TO 720
15700	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
15800		KED=0
15900		JED=0
16000		GO TO 72
16100	720	IF(JA.EQ.44)GO TO 420
16200		IF(JA.EQ.33)GO TO 33
16300		IF(JA.EQ.24)GO TO 24
16400	C  FOR '24' WHILE IN EDIT MODE.  MAGS WITH CURSOR AS CENTER.
16500		IF(MOD(JA,100).GT.13.OR.JA.EQ.1)GO TO 5505
16550	CC	IF(JA.GT.13.OR.JA.EQ.1)GO TO 5505
16600	C  PARAM NUM TOO HIGH?
16700	C  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
16800	4221	IF(X22.EQ.0)GO TO 5517
16850		IF(R2.NE.0)GO TO 5517
16900	C  BACKS UP WHEN IN EDIT MODE.
17000	
17100		IF(JA.GT.0)GO TO 5518
17200		IF(I.EQ.IX)GO TO 91
17300		ZERO=X22+1
17400	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
17500	72	IF(X22.EQ.0)GO TO 55
17600		IF(KED.EQ.0)REDIT=999.
17700	320	IF(I.NE.IX)GO TO 172
17800		ITEM=ITEM-1
17900	C  TO DELETE AN ITEM
18000	73	X22=0 
18100		CALL CLRCUR
18200		CALL DPYNEW
18300		IF(REDIT.EQ.999.)GO TO 441
18400		IF(JA.EQ.55)GO TO 554
18500		IF(JA.EQ.44)GO TO 44
18600	441	IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
18800	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
18900	424	X22=R2
19000	425	IF(X22.GT.ITEM)GO TO 73
19100	C  LEAVES EDIT MODE.
19200	429	IX=I
19300		MEDIT=PWDS(X22)
19400		J=2
19500	426	Y=RN(MEDIT)+J
19601		CALL LOOP(0,Y,1,I,MEDIT,RN)
19700		JJA=RN(I+1)
19800		YED=Y-2
19900		L=I+2
20000		DO 422 K=1,11
20100		IF(K.GT.YED)GO TO 423
20200		RJJ(K)=RN(L+K)
20300		GO TO 422
20400	423	RJJ(K)=0
20500	422	CONTINUE
20600		RJJ2=RN(L)
20700		IF(IGO.GT.0)GO TO 4231
20800	C  NO BOX WHEN IN GROUP EDIT ROUTINE
20900		IBOX=I
21000		RBOX=RJJ2
21100		CALL BOX(IBOX,RBOX,STFF)
21200	4231	ITEM=ITEM+1
21300		ST2=WDS(ITEM)
21400		GO TO 55
21500	
21600	5517	IF(JA.EQ.0)GO TO 6221
21650	5518	X=100-JA
21675		IF(X)JA=JA/100
21700		IF(JA.EQ.2)GO TO 7221
21800		IF(JA.GE.22)GO TO 55
21805		I1=JA-2
21810		IF(X)GO TO 224
21900		RJJ(I1)=R2
22100		GO TO 6222
22110	224	RJJ(I1)=RJJ(I1)+R2
22120		GO TO 6222
22200	
22300	7555	CALL MOVER
22400		IF(R3.EQ.99)GO TO 5504
22500	C   99=BACKUP OUT OF MOVER ETC.
22600		IGO=0
22605		JFONT=0
22607	C  SO IT WON'T DO ALL FONT LOOKUPS.
22610	8853	IF(JJ2)GO TO 5505
22700		M=PWDS(JJ2)
22800		I=PWDS(ITEM+1)
22900		ITEM=JJ2-1
23000		ST2=WDS(JJ2)
23100	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
23200		GO TO 8852
23300	
23400	8851	IF(I1.NE.IP)GO TO 85
23500		GO TO 6531
23600	
23700	420	REDIT=0
23800	211	IF(R2.NE.0)GO TO 320
23900		IF(KED.GE.0)RLINE=RJ3
24000	CC	R3=RLINE
24025		RJ3=RLINE
24050	CC	X=0
24062		GO TO 6222
24100	C  FOR '55' ALIGNING
24110	7221	IF(X)GO TO 4223
24200		RJJ2=R2
24210		GO TO 6222
24220	4223	RJJ2=R2+RJJ2
24300	CC6222	IF(JQ(1).EQ.0)GO TO 6221
24400	C  ARRAYS NEED 2O LOCATIONS HERE.
24500	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
24600	6222	DO 1222 K=1,20,2
24700		L=JQ(K)
24705	CC	IF(L.EQ.0)GO TO 5223
24707		IF(L.EQ.0)GO TO 6221
24710		JA=100-L
24720		IF(JA)L=L/100
24730	C  600 2  WILL ADD 2 TO PARAM 6.
24740		RD=RJQ(K+1)
24745		X=L-2
24750		IF(JA.GT.0)GO TO 223
24760		IF(L.EQ.2)GO TO 1223
24770		RD=RJJ(X)+RD
24780		GO TO 2223
24790	1223	RD=RJJ2+RD
24800	223	IF(L.EQ.2)GO TO 3223
24810	2223	RJJ(X)=RD
24820		GO TO 1222
24830	3223	RJJ2=RD
25300	1222	CONTINUE
25400	C***  LOOP SET TO 11 (20 IN ARRAY!)
25450	CC5223	R2=RJJ2
25500	6221	DO 5514 K=1,11
25600		RJQ(K)=RJJ(K)
25700	5514	JQ(K)=RJQ(K)
25750		R2=RJJ2
25800		JA=JJA
25900		ITEM=ITEM-1
26000		IF(ITEM)ITEM=0
26100		ST2=WDS(ITEM+1)
26200		I=PWDS(ITEM+1)
26300		CALL DPYNEW
     

54300	60	J2=R2
54400		RSTJ2=RSTFAC(J2)
54410		RD=0
54420		IF(PLT.NE.0)GO TO 5541
54430		IF(JA.NE.8)GO TO 70
54440		IF(R9.NE.1)GO TO 70
54442		R9=RN(MEDIT+9)
54445		IF(R9.NE.' ')TYPE 427,R9
54450		TYPE 21
54460		ACCEPT FA5,R9
54470		IF(R9.EQ.LY(1))R9=0
54480	C  WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
54510	70	IF(JA.NE.11)GO TO 63
54525		IF(J10.NE.1)GO TO 62
54540		TYPE 21
54555		ACCEPT FA5,NJR
54585	C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
54587		LASTNM=NJR
54590	62	IF(NJR.EQ.0)NJR=LASTNM
54595	C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
54600	CC63	IF(JA.EQ.50)JA=16
54700	C  ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
54800	63	IF(R3.LT.1000)GO TO 66
54900		RD=R3
55000		IF(JA.EQ.5)R13=R3/1000.
55100		CALL RNOTE(R3)
55200	C IF R3>1000 IT FINDS TRUE R3 THROUGH NOTE NUMB.
55600	66	IF(JA.NE.16)GO TO 160
55650	C  USE P10≠0 TO LINK UP TEXT.
55700	CCZZZZZZ	IF(J10.EQ.0.OR.PLT.NE.0)GO TO 160
55725		IF(J10.EQ.0)GO TO 160
55750		R10=0
55810		K=ITEM
55820		IF(X22.NE.0)K=X22-1
55835		K=PWDS(K)
55850		R3=R5*RSTJ2*RN(K+9)+RN(K+3)
55900	C  PUTS 13TH(+) LETTER IN RIGHT POS. AFTER HORIZ. MOVE.
55920	160	IF(EDX.NE.0)GO TO 162
55933		IF(I1.EQ.IP)GO TO 5541
55946	162	RJ3=R3
55972		JJA=JA
55986		IF(R8.NE.0)GO TO 161
56000		IF(JA.EQ.1)R8=999.
56100	C  999=0 FOR STEM EXTENSIONS.
56200	161	CNT=1
56300		DO 5543 K=1,9
56400	C  10/6/73 ABOVE WAS ,11
56500		RA=RJQ(K)
56600		IF(RA.NE.0)CNT=K
56700	5543	RJJ(K)=RA
56800	C  USES ONLY 10 PARAMETERS BEYOND JA, J2
56900	2554	IF(PLT.NE.0)GO TO 5541
57000		IF(JA.EQ.6)CALL HOMER
57100		IF(JA.NE.13)GO TO 1261
57200		IF(J6.NE.0)R13=-1
57300	
57400	1261	IF(R13.NE.0)CALL HOMER
57500	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
57600	C **** FOR '0' EDITS ******
57700	261	RN(I)=CNT
57800		RN(I+1)=JA
57900		I=I+2
58000		RN(I)=R2
58100		IF(RD.NE.0)RN(I)=RD
58200	C TO SAVE NOTE NUMBS IN P2.
58300		DO 4554 K=1,CNT
58400	4554	RN(I+K)=RJQ(K)
58500	3554	I=CNT+1+I
58510	5541	IF(DP(J2))GO TO 57
58520	C*** 3/74  NEW DP SYSTEM
58600	C  WHAT ABOUT EDITS?*******
58700		POS=STFF(J2)
58800		J3=ROFF(RHORZ(R3))
58900	C  LINE IS DIVIDED INTO 200 POINTS.
59000		CALL CENTX
59005	C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
59010		R3=J3
59020		IF(JA.LE.2)GO TO 11
59030	551	GO TO(1,1,68,25,67, 25,116,125,11,69, 68,67),JA
59040		GO TO (116,81,80),JA-15
59050	C  FOR 16,17,18 (WORDS, KSIG, METER)
59060	
61630	222	I=PWDS(ITEM+1)
61640		GO TO 5505
61650	C  44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
61700	
61710	69	CALL MAKNUM(R5)
61713		GO TO 57
61716	
61719	68	CALL CLEFS
61722		GO TO 57
61725	
61728	67	CALL SLUR
61731		GO TO 57
61734	
61737	116	CALL ALPHA
61740		GO TO 57
61743	
61746	81	CALL KSIG
61749		GO TO 57
61752	
61755	80	CALL METER
61758		GO TO 57
61761	
61764	61	CALL HOMER
61767		GO TO 8853
61770	125	IF(R2.EQ.0)RMOV=R8
61773	25	CALL ITMSUB
61776	C   BAR LINES, BEAMS, STAFF LINES ****
61779		GO TO 57
61782	
61800	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
61810	120	IF(I.EQ.1)GO TO 1220
61900		IF(I2.NE.IM)GO TO 222
62000	C  'GM'=GET MORE
62100	1220	TYPE 21
62200		ACCEPT FA5,NAME
62300		IF(NAME.EQ.'99')GO TO 5505
62310		IF(NAME.EQ.IBL)GO TO 2220
62400		IF(LOOKD(NAME).EQ.0)GO TO 120
62500	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
62550	2220	JA=-1
62575	C  -1 IS FOR 8852+3
62600	3005	REWIND 21
62700	C  GUARDS AGAINST LOSSAGE!
62800		PLOTIT=-1
62900		IF(I1.NE.IG)PLOTIT=-2
63000	2005	IF(NAME.EQ.IBL)GO TO 2200
63100		CALL IFILE(21,NAME)
63200	C  JUMP TO READ BIG FILES
63300	2200	J=ITEM+1
63400	2202	READ(21,END=2207),X,Y,
63500		1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
63600		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF,K
63710	C (K) BUG IN FORTRAN UNFORMATTED READ-WRITE. SOMETIMES LAST ITEMS WRONG.
63800	2207	IF(Y.EQ.0)GO TO 2205
63900		ITEM=ITEM+X
64000		IF(I2.EQ.IM)GO TO 2203
64100		I=Y
64200	CC	READ(21,END=8851),RSTFAC,STFF
64300		IF(I1.EQ.IP)GO TO 6531
64400	22222	READ(21,END=8851),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
64500		CALL DPYNEW
64600		GO TO 5505
64700	2205	TYPE 2206
64800		CALL EXIT
64900	2206	FORMAT(' **** UNPACK IT! ****')
65000	
65100	2203	RA=I-1
65200		DO 2204 K=J,J+X
65300	2204	PWDS(K)=PWDS(K)+RA
65400		GO TO 85
65500	121	IF(PLOTIT.EQ.0)GO TO 5504
65600	5121	CALL PLTSRT
65650		M=IX
65700	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
65800	CC	PLT=-1-J8
65850		PLT=-1
65900	C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
66000	CC	M=I
66100	CC	I=I+M-1
66150	C M IS SET UP IN PLTSRT
66200		CALL NOZERO(R2)
66300		DIS=R2*1.24
66400		IF(R3.EQ.0)R3=R2
66500		RHT=R3*1.2
66600	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
66700		BOT=-BOT*RHT
66800		IF(TOP2.EQ.-999)GO TO 8121
66900		BOT=BOT+TOP2
67000		GO TO 9121
67100	8121	CALL PLOTS(K)
67110		RNOMOV=0
67200	9121	IF(R7.EQ.0)R7=RMOV
67250	C RMOV HAS INCHES FROM P8 OF STAFF 0.
67260		IF(RNOMOV.GT.1)BOT=RNOMOV
67300		RNOMOV=R6+R7*200.*R3
67310	CC	RNOMOV=R6+R7*202.*R3
67350		RMOV=0
67400	C  R6=1 FOR NO MOVE AT END.  R7=INCHES TO MOVE FOR NEW STAFF 0.
67500	C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
67600	C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE.  THEN
67700	C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
67750		IF(J5.NE.0)GO TO 6120
68200	6121	CALL PLOT(0,BOT,-3)
68300	C  MOVES PLOTTER UP IF P5=0.
68500	
68600	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
68700	6120	IF(M.GE.I)GO TO 7120
68800		CNT=RN(M)
68900	C  CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
69000		DO 6220 K=CNT+1,10
69100		JQ(K)=0
69200	6220	RJQ(K)=0
69300		JA=RN(M+1)
69400		M=M+2
69500		R2=RN(M)
69600		DO 9120 K=1,CNT
69700		RJQ(K)=RN(M+K)
69800	9120	JQ(K)=RJQ(K)
69900		M=CNT+M+1
70000		IF(EDX.LE.0)GO TO 60
70100		GO TO 5505
70200	
70300	7120	M=1
70400		IF(EDX)GO TO 71201
70500		IF(PLT.EQ.1)EDX=-1
70600		PLT=0
70800		GO TO 5505
70900	71201	X=50*RHT
71000		TOP=TOP*RHT+X
71100		IF(RNOMOV.NE.0)TOP=0
71200		IF(RNOMOV.GT.1)TOP=RNOMOV
71310		CALL PLOT(0,TOP,3)
71400		TOP2=TOP
71500		GO TO 2
71600	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
71700	CC7121	CALL PLOT(0,TOP,3)
71800	C  MOVES PLOTTER UP
71900	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
72000	CC	TOP2=TOP
72100	CC	GO TO 2
72200	
72300	56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I,I6/)
72400	1	FORMAT(I,24F)
72500	21	FORMAT(' FILE NAME?  '$)
72600		END